OutReservoirs Subroutine

public subroutine OutReservoirs(list, time, Qin, Qout)

write results on files

Arguments

Type IntentOptional Attributes Name
type(Reservoir), intent(in), POINTER :: list
type(DateTime), intent(in) :: time
type(grid_real), intent(in) :: Qin
type(grid_real), intent(in) :: Qout

Variables

Type Visibility Attributes Name Initial
type(Reservoir), public, POINTER :: currentReservoir
real(kind=float), public :: volume
real(kind=float), public :: wse

Source Code

SUBROUTINE OutReservoirs &
  !
  (list, time, Qin, Qout)

IMPLICIT NONE


!arguments with intent(in):
TYPE (Reservoir), POINTER, INTENT(IN) :: list !list of reservoirs
TYPE (DateTime),           INTENT(IN) :: time
TYPE (grid_real),          INTENT(IN) :: Qin
TYPE (grid_real),          INTENT(IN) :: Qout

!local declarations:
TYPE(Reservoir), POINTER   :: currentReservoir !current reservoir in alist
REAL (KIND = float)        :: volume !water stored in reservoir (m3)
REAL (KIND = float)        :: wse !water surface elevation 

!------------------------------end of declarations-----------------------------
timeString = time
currentReservoir => list
DO WHILE (ASSOCIATED(currentReservoir)) !loop trough all reservoirs
    wse = currentReservoir % stage
    CALL TableGetValue ( valueIn =  wse, tab = currentReservoir % geometry, &
                                     keyIn = 'h', keyOut ='volume', &
                                     match = 'linear', valueOut = volume, &
                                     bound = 'extendlinear' )
    SELECT CASE ( currentReservoir % typ)
    CASE ( 'off' )
        IF ( currentReservoir % bypassIsPresent ) THEN
            WRITE(currentReservoir % fileunit_out,'(a,6(" ",e14.7) )') timeString,&
              currentReservoir % stage, volume, &
              Qin % mat(currentReservoir % r, currentReservoir % c),&
              Qout % mat(currentReservoir % r, currentReservoir % c), &
              currentReservoir % bypass % QinChannel, &
              currentReservoir % bypass % QoutChannel
        ELSE
             WRITE(currentReservoir % fileunit_out,'(a,4(" ",e14.7) ) ') timeString,&
               currentReservoir % stage, volume, &
               Qin % mat(currentReservoir % r, currentReservoir % c),&
               Qout % mat(currentReservoir % r, currentReservoir % c)
        END IF 
    CASE ( 'on' )
        IF ( currentReservoir % bypassIsPresent ) THEN
            WRITE(currentReservoir % fileunit_out,'(a,6(" ",e14.7) )') timeString,&
              currentReservoir % stage, volume, &
              Qin % mat(currentReservoir % r, currentReservoir % c),&
              Qout % mat(currentReservoir % r, currentReservoir % c), &
              currentReservoir % bypass % QinChannel, &
              currentReservoir % bypass % QoutChannel
        ELSE
             WRITE(currentReservoir % fileunit_out,'(a,6(" ",e14.7) )') timeString,&
               currentReservoir % stage, volume, &
               Qin % mat(currentReservoir % r, currentReservoir % c),&
               Qout % mat(currentReservoir % r, currentReservoir % c), &
               0.0, 0.0
        END IF
    END SELECT
    
     currentReservoir => currentReservoir % next
    
END DO

RETURN
END SUBROUTINE OutReservoirs